COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C DUPINS.F4  TO DUPLICATE INSTRUMENTS IN FILES
C00009 ENDMK
C⊗;
C DUPINS.F4  TO DUPLICATE INSTRUMENTS IN FILES
C ****** LOAD WITH FORNAM.FAI (INCLUDES RENAM.FAI) *********
	DIMENSION I(72),J(200,72),LINC(5)
	COMMON NM,LNUM
 	DATA LINC/536870912,4194304,32768,256,2/
	IFOUND=0
	IEXT=' '
	OEXT=' '
	TYPE 1
1	FORMAT(' **** MAKES DUPLICATES OF INSTRUMENTS ****'/
	1' ALL FILE NAMES AND INSTRUMENT NAMES CAN HAVE NO MORE THAN 
	15 LETTERS'//' TYPE INPUT FILE NAME.EXT   '$)
2	FORMAT(2A5,A1,2A5)
202	FORMAT(1X2A5,A1,2A5)
	ACCEPT 8,I
	CALL NAMEXT(I,NAME,IEXT)

70	CALL FORNAM(NAME,IEXT)
CCC	CALL IFILE(1,INAME)
3	FORMAT(' OUTPUT FILE NAME.EXT   '$)
	TYPE 3
	ACCEPT 8,I
	CALL NAMEXT(I,ONAME,OEXT)
4	FORMAT(' INST. TO BE DUPLICATED --'$)
5	TYPE 4
	ACCEPT 2,NM
	IF(NM.EQ.' ')GO TO 5
	REREAD 8,I
	TYPE 40
	ACCEPT 41,K
	NUM=K+1
	DO 44 K=1,72
44	IF(I(K).EQ.' ')GO TO 45
45	LNUM=K-1
C***********	GO TO 5
C LNUM IS NUMB OF LETTERS IN INST NAME.
40	FORMAT(' HOW MANY DUPLS?   '$)
41	FORMAT(I)
42	CALL OFILE(21,'$')
	IDIR=0
	IJ=1
6	READ(1,2,END=100),K
	REREAD 8,I
	IF(I(3).NE.';')GO TO 43
	IDIR=0
C THIS STUFF TO AVOID DIRECTORY
	GO TO 6
43	IF(K.EQ.'COMME')IDIR=-1
	IF(IDIR)GO TO 6
	CALL SHORT(I,L)
	IF(K.EQ.'INSTR')GO TO 7
8	FORMAT(72A1)
88	FORMAT(1X72A1)
9	WRITE(21,8)(I(N),N=1,L)
	GO TO 6
7	IF(NOTNAM(N).EQ.0)GO TO 105
	TYPE 88,(I(N),N=1,L)
	GO TO 9
C NEXT FOUND NAME TO DUPLICATE
105	INC=LINC(LNUM)
	REREAD 2,KK,LL,MM,NM,NNN
	NJ=0
	GO TO 10
103	PAUSE 'NO "END;" FOUND'
12	READ(1,8,END=103)I
10	NJ=NJ+1
	DO 11 K=1,72
11	J(NJ,K)=I(K)
C PUT A LINE INTO J ARRAY
	IF(I(1).NE.'E')GO TO 12
	IF(I(2).NE.'N')GO TO 12
	IF(I(3).NE.'D')GO TO 12
C USE 5-LETTER NAMES!!!
	IFOUND=-1
	NZ=0
104	JK=0
	NZ=NZ+1
13	JK=JK+1
	DO 14 K=1,72
14	I(K)=J(JK,K)
	IF(JK.NE.1)GO TO 50
	WRITE(21,2)KK,LL,MM,NM,NNN
	TYPE 202,KK,LL,MM,NM,NNN
C THIS LINE HAS INST. NAME.
	NM=NM+INC
	GO TO 15
50	CALL SHORT(I,K)
	WRITE(21,8)(I(N),N=1,K)
CC	TYPE 88,(I(N),N=1,K)
15	IF(JK.LT.NJ)GO TO 13
	IF(NZ.LT.NUM)GO TO 104
	GO TO 6
100	IF(IFOUND)GO TO 1000
	TYPE 1000,NM
	CALL EXIT
1000	FORMAT(' ***** INSTRUMENT ',A5,' NOT FOUND *****')
	TYPE 101,ONAME,OEXT
101	FORMAT(/' DUPLICATE INSTS ON FILE -- ',A5,'.',A3)
	END FILE 21
	REWIND 21
	CALL RENAM('$','DAT',ONAME,OEXT)
	END

	SUBROUTINE SHORT(I,K)
	DIMENSION I(1)
	DO 1 K=72,1,-1
1	IF(I(K).NE.' ')RETURN
	END

	FUNCTION NOTNAM(N)
	COMMON NM,LNUM
	DIMENSION FM(3),A(5)
	DATA A/'A1)','A2)','A3)','A4)','A5)'/
	1 ,FM/'(2A5,','A1,',0/
	FM(3)=A(LNUM)
	NOTNAM=0
	REREAD FM,K,K,K,K
1	IF(K.NE.NM)NOTNAM=-1
	END

	SUBROUTINE NAMEXT(I,NAME,IEXT)
	DIMENSION  A(5),FM(5),I(1)
	DATA A/'A1','A2','A3','A4','A5'/,FM(1)/'('/
	EQUIVALENCE (A5,A(5)),(FM2,FM(2)),(FM3,FM(3)),(FM4,FM(4)),
	1 (FM5,FM(5)),(A3,A(3))
	DO 69 K=2,5
69	FM(K)=' '
	ID=0
	IA=0
	NAME=' '
	DO 61 K=20,1,-1
	IF(I(K).EQ.' ')GO TO 61
65	DO 62 L=K-1,1,-1
	N=I(L)
63	IF(N.NE.'.')GO TO 62
	ID=L
C '.' ASSUMES THERE IS AN EXTENSION 
	GO TO 64
62	CONTINUE
	GO TO 64
61	CONTINUE
C ALL BLANK IF WE GET HERE
64	IF(ID.NE.0)GO TO 67
C NOW ONLY A NAME IS ON THIS LINE
	FM2=A5
	FM3=')'
	REREAD FM,NAME
	GO TO 70
67	FM3=',A1,'
	FM2=A(ID-1)
	FM4=A3
	FM5=')'
C  FOUND NAME AND EXTENSION
	REREAD FM, NAME,K,IEXT
70	END